package SetSolution;
use strict;
use SurvivalProbability;
use List::Util qw(first max maxstr min minstr reduce shuffle sum);

=head1 NAME

SetSolution - Stores subsets of species corresponding to greedy solutions

=head1 DESCRIPTION

The simpler the instance of the NAP the more equally good solutions there 
will be to the NAP. This class permits these solutions to be stored in a 
efficient tree structure.

=begin comment

 Type    : Constructor
 Title   : new
 Usage   : my $ss = SetSolution->new
 Function: Initializes a SetSolution object.
 Alias   :
 Returns : A SetSolution object.
 Args    : 

=end comment

=cut
sub new {
	
	my $class = shift;
    my $self;
    #The species that could be added to this set in a greedy fashion
    $self->{sets}->{''}->{increment} = [];
    $self->{sets}->{''}->{decrement} = [];
    #The PD increase due to the addition of each of these species
    $self->{sets}->{''}->{epd} = 0;
    #The cost of conserving this set of species
    $self->{sets}->{''}->{cost} = 0;
    #The set of species is an empty set
    $self->{sets}->{''}->{species} = [];
    #The name of the set
#    $self->{sets}->{''}->{name} = 'No Conservation';
    $self->{sets}->{''}->{generic_name} = sprintf("S%4d", 0);
    
    #A counter for giving solutions generic names
    $self->{set_name_counter} = 1;
    
    bless $self, $class;
    return $self;
}

=begin comment

 Type    : Mutator
 Title   : add_transition
 Usage   : my $ss->add_transition(\@set,\@additions,\@pdgain,\@cost)
 Function: Adds a transition for an original set 
 Alias   :
 Returns : 1 if success, 0 if failure (@set is invalid)
 Args    : @set: the current set of species 
           @additions: the species that could be added in a greedy fashion
           @pdgain: the PD increase that each addition provides (equal unless 
           the costs are variable
           @cost: the cost of conserving each of the additions

=end comment

=cut
sub add_transition {
	#get the input
	my $self = shift;
	my @set = @{shift(@_)};
	my @additions = @{shift(@_)};
	my @pdgain = @{shift(@_)};
	my @cost = @{shift(@_)};
	
	my $setsize = scalar @set;

    #Get the hash key for this set
	my $src_hash = _get_hash_key(@set);
    
    #For each possible addition for this set we make appropriate entries
    for (my $index = 0; $index < @additions; $index++) {

    	#The destination hash key
		my $dest_hash = _get_hash_key($additions[$index],@set);
		
		#Check the $src_hash key exists
		unless (exists $self->{sets}->{$src_hash}) { return 0; }
		
		#Set destination cost, epd and species set
		$self->{sets}->{$dest_hash}->{cost} = $self->{sets}->{$src_hash}->{cost} + $cost[$index];
		$self->{sets}->{$dest_hash}->{epd} = $self->{sets}->{$src_hash}->{epd} + $pdgain[$index]; 
		$self->{sets}->{$dest_hash}->{species} = [SurvivalProbability::_unique_sorted_names_(@{$self->{sets}->{$src_hash}->{species}}, $additions[$index])]; 
		
		#Set the generic name for this solution
		unless (defined $self->{sets}->{$dest_hash}->{generic_name}) {
			$self->{sets}->{$dest_hash}->{generic_name} = sprintf("S%4d", $self->{set_name_counter});
			$self->{set_name_counter}++;
		}
		
		#Add the source to the destinations decrement pointers and species names
		push( @{$self->{sets}->{$dest_hash}->{decrement}}, $self->{sets}->{$src_hash});
		push( @{$self->{sets}->{$dest_hash}->{decrement_spp}}, $additions[$index]);
		
		#Add the destination the the sources increment pointsr
		push( @{$self->{sets}->{$src_hash}->{increment}}, $self->{sets}->{$dest_hash});
		push( @{$self->{sets}->{$src_hash}->{increment_spp}}, $additions[$index]);
    }
    #Delete any pre-computed stats -- they will need to be regenerated
    delete $self->{stats};
	return 1;
}

#Get the cost of a particular solution
sub get_solution_cost {
	my $self = shift;
	my $name = shift;
	my $solution = $self->get_solution_by_name($name);
	return $solution->{cost};
}

#Get the EPD of a particular solution
sub get_solution_epd {
	my $self = shift;
	my $name = shift;
	my $solution = $self->get_solution_by_name($name);
	return $solution->{epd};
}

#Get a solution by its name
sub get_solution_by_name {
	my $self = shift;
	my $name = shift;
	foreach (keys %{$self->{sets}}) {
		if ((!(defined $self->{sets}->{$_}->{name}) && $self->{sets}->{$_}->{generic_name} eq $name) ||
			(defined $self->{sets}->{$_}->{name} && $self->{sets}->{$_}->{name} eq $name)) {
			return $self->{sets}->{$_};
		}
	}
	return undef;
}

#Get all sets of n species
sub get_sets_n {
	my $self = shift;
	my $n = shift;
	my @output;
	foreach my $setHash (keys %{$self->{sets}}) {
		if (@{$self->{sets}->{$setHash}->{species}} == $n) {
			push(@output, $self->{sets}->{$setHash}->{species});
		}
	}
	return @output;
}

#Get all solutions
sub get_solutions_all {
	my $self = shift;
	return $self->get_solutions_n(-1);
}

#Get solutions of a given size
sub get_solutions_n {
	my $self = shift;
	my $n = shift;

	my @output;
	my $index = 0;
	#store each solution
	my $sets = $self->{sets};
	foreach my $setHash (keys %{$sets}) {
		if ($n == -1 || @{$sets->{$setHash}->{species}} == $n) {
			$output[$index]->{increment} = $sets->{$setHash}->{increment_spp};
			$output[$index]->{decrement} = $sets->{$setHash}->{decrement_spp};
			#The set itself!
			$output[$index]->{set} = $sets->{$setHash}->{species};
			#The cost of conserving all species in this set
			$output[$index]->{cost} = $sets->{$setHash}->{cost};
					#Return the name
					if (defined $sets->{$setHash}->{name}) {
						$output[$index]->{name} = $sets->{$setHash}->{name};
						$output[$index]->{named} = 1;
					} else {
						$output[$index]->{name} = $sets->{$setHash}->{generic_name};
						$output[$index]->{named} = 0;
					}
			  
			$index++;
		}		
	}
	return @output;
	
}

#Get array of solutions of a given cost -- could be made much more efficient by storing the species along 
#with the pointer in the increment/decrement field.
sub get_solutions_cost {
	my $self = shift;
	my $budget = shift;
	my @output;
	
	my $sets = $self->{sets};
	
	my $index = 0;
	
	#if ($budget <= $self->{sets}->{''}->{cost}) {
	#	
	#	push(@output, 
	#}
	
	
	#For each permissible set of that size
	foreach my $setHash (keys %{$sets}) {
		
		my $cost = $sets->{$setHash}->{cost};
		
			
		if ( $cost >= $budget ) {
			my $included = 0;	
			if ($setHash eq '') { $included = 1; }		
			#Check each set from which this set can be obtained to check if the transition crossed the budget value
			foreach (@{$sets->{$setHash}->{decrement}}) {
				if ($_->{cost} < $budget) {
					$included++;
					my $thiskey = _get_hash_key(@{$_->{species}});
					my $addition = _hash_diff($setHash,$thiskey);  
					push (@{$output[$index]->{decrement}},$addition);
				} 
			}
			if ($included) {
				#Set the array of species that can be added to obtain the next highest greedy solution
				foreach (@{$sets->{$setHash}->{increment}}) {
					my $thiskey = _get_hash_key(@{$_->{species}});
					my $addition = _hash_diff($setHash,$thiskey);  
					push (@{$output[$index]->{increment}},$addition);
				}
				#The set itself!
				$output[$index]->{set} = $sets->{$setHash}->{species};
				#The cost of conserving all species in this set
				$output[$index]->{cost} = $sets->{$setHash}->{cost};
				
				#Return the name
				if (defined $sets->{$setHash}->{name}) {
					$output[$index]->{name} = $sets->{$setHash}->{name};
					$output[$index]->{named} = 1;
				} else {
					$output[$index]->{name} = $sets->{$setHash}->{generic_name};
					$output[$index]->{named} = 0;
				}
				
				if ($cost == $budget) { $output[$index]->{partial} = 0; }
				else  { $output[$index]->{partial} = 1; }
				  
				$index++;
			}
		}	
	}
	return @output;
}

#Get sets of a given cost 
sub get_solution_names_cost {
	my $self = shift;
	my $budget = shift;
	my @output;
	
	my $sets = $self->{sets};
	
	my $index = 0;
	
	#Check each solution
	foreach my $setHash (keys %{$sets}) {
		
		my $cost = $sets->{$setHash}->{cost};
		
			
		if ( $cost >= $budget ) {
			my $included = 0;	
			if ($setHash eq '') { $included = 1; }		
			#Check each set from which this set can be obtained to check if the transition crossed the budget value
			foreach (@{$sets->{$setHash}->{decrement}}) {
				if ($_->{cost} < $budget) {
					$included++;
				} 
			}
			if ($included) {
				if (defined $sets->{$setHash}->{name}) {
					push(@output, $sets->{$setHash}->{name});
				} else {
					push(@output, $sets->{$setHash}->{generic_name});
				}
			}
		}	
	}
	return @output;
}

#Returns the pd for a particular budget
sub get_budget_pd {
	my $self = shift;
	my $budget = shift;
	my %points = $self->get_cost_pd();
	my @sorted = sort keys %points;
	
	if ($budget >= $sorted[-1]) { return $points{$sorted[-1]}}
	
	for (my $index = 0; $index < @sorted; $index++) {
		if ($sorted[$index]+1 > $budget) {
			return $points{$sorted[$index-1]} + 
				($budget-$sorted[$index-1])/($sorted[$index]-$sorted[$index-1]) *
				($points{$sorted[$index]} - $points{$sorted[$index-1]});
		}
	}
	return undef;
}

#Returns a hash keys are costs, values are epd
sub get_cost_pd {
	my $self = shift;
	my %out;
	
	foreach (keys %{$self->{sets}}) {
		$out{$self->{sets}->{$_}->{cost}} = $self->{sets}->{$_}->{epd}; 
	}
	return %out;
	
} 

#Gets the cost of conserving a given set of species (provided they are a greedy solution)
sub get_cost_set {
	my $self = shift;
	my $key = _get_hash_key(@_);
	return $self->{sets}->{$key}->{cost};
}

#Returns a hash with survival probabilities for each species, input is the solution name
sub get_expenditure {
	my $self = shift;
	my $name = shift;
	my %output;
	foreach (keys %{$self->{sets}}) {
		if ( $name eq $self->{sets}->{$_}->{generic_name} || ((defined $self->{sets}->{$_}->{name}) && ($name eq $self->{sets}->{$_}->{name})) ) {
			foreach ( @{$self->{sets}->{$_}->{species}} ) {
				$output{$_} = -1;
			}
			return %output;
		}
	}
	return undef;
}

#Get all set solution names
sub get_solution_names {
	my $self = shift;
	my @output;
	foreach (keys %{$self->{sets}}) {
		if (defined $self->{sets}->{$_}->{name}) {
			push(@output, $self->{sets}->{$_}->{name});
		}
	}
	return @output;
}

#Sets the name associated with a particular solution
sub set_solution_name {
	my $self = shift;
	my $name = shift;
	my $hash_key = _get_hash_key(@_);
	if (defined $self->{sets}->{$hash_key}) {
		$self->{sets}->{$hash_key}->{name} = $name;
		return 1;
	} else { return 0; }
}

#Unset the solution name, returns the generic name on success
sub unset_solution_name {
	my $self = shift;
	my $hash_key = _get_hash_key(@_);
	if (defined $self->{sets}->{$hash_key}) {
		delete $self->{sets}->{$hash_key}->{name};
		return $self->{sets}->{$hash_key}->{generic_name};
	} else { return 0; }
	
}

#Get the difference in species between two hashes
sub _hash_diff {
	
	my @set1 = _convert_hash_key($_[0]);
	my @set2 = _convert_hash_key($_[1]);
	
	return _set_diff(\@set1,\@set2);
}
	
#Get the difference in species between two lists 	
sub _set_diff {
	my @set1 = @{ shift(@_)};
	my @set2 = @{ shift(@_)};	
	my %hash;
	
	my @output;
	
	foreach (@set1) { $hash{$_} = 1; }
	foreach (@set2) {
		if ($hash{$_}) { delete $hash{$_}; }
		else { push (@output,$_); }
	}
	foreach (keys %hash) { push(@output,$_); } 
	if (scalar @output == 1) { return $output[0]; } else { return @output; }
}

#Convert the hash key to a list of species names
sub _convert_hash_key {
	my $key = shift;
	my @out = ($key =~ /[^ ]+/g);
	return @out;
}

#Convert a list of species names to a hash key
sub _get_hash_key {
	my @sorted = SurvivalProbability::_unique_sorted_names_(@_);
	my $hash;
	$hash = "";
	foreach (@sorted) { $hash .= $_.' '}
	$hash = substr($hash,0,-1);
	return $hash;
}

#The minimum list index
sub get_min {
	my $self = shift;
	my %output;
	#Ensure the stats have been calculated
	unless (defined $self->{stats}) { $self->_calculate_stats($self->{sets}->{''}); }
	
	#Get the minimum value for each species
	foreach (keys %{$self->{stats}}) {
		$output{$_} = min @{$self->{stats}->{$_}};
	}
	return \%output;
}

#The minimum list index
sub get_max {
	my $self = shift;
	my %output;
	#Ensure the stats have been calculated
	unless (defined $self->{stats}) { $self->_calculate_stats($self->{sets}->{''}); }
	
	#Get the minimum value for each species
	foreach (keys %{$self->{stats}}) {
		$output{$_} = max @{$self->{stats}->{$_}};
	}
	return \%output;
}

#The minimum list index
sub get_mean {
	my $self = shift;
	my %output;
	#Ensure the stats have been calculated
	unless (defined $self->{stats}) { $self->_calculate_stats($self->{sets}->{''}); }
	
	#Get the minimum value for each species
	foreach (keys %{$self->{stats}}) {
		$output{$_} = (sum @{$self->{stats}->{$_}})/(scalar @{$self->{stats}->{$_}});
	}
	return \%output;
}

#Calculate stats
sub _calculate_stats {
	my $self = shift;
	my $solution = shift;
	#Add to the stats
	foreach (@{$solution->{increment_spp}}) {
		unless (defined $self->{stats}->{$_}) {
			$self->{stats}->{$_} = [];
		}
		push(@{$self->{stats}->{$_}}, @{$solution->{species}} + 1);
	}
	foreach (@{$solution->{increment}}) {
		$self->_calculate_stats($_);
	}
}

1;